home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / RELATION.TPX < prev    next >
Text File  |  1994-03-02  |  61KB  |  876 lines
  1. #!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
  2. #!│                              Relation.TPX              │Version: 3007.105│
  3. #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
  4. #!│Structure             Type       Description                              │
  5. #!│────────────────────  ─────────  ─────────────────────────────────────────│
  6. #!│RIUpdates             GROUP                                               │
  7. #!│WriteUpdates          GROUP                                               │
  8. #!│RIDeletes             GROUP                                               │
  9. #!│WriteDeletes          GROUP                                               │
  10. #!│InitLogout            GROUP                                               │
  11. #!│BtrieveTrxFraming     GROUP                                               │
  12. #!│SavePrimaryLinks      GROUP                                               │
  13. #!│ConcurrentWrite       GROUP                                               │
  14. #!│ConcurrentDelete      GROUP                                               │
  15. #!│DriverCheck           GROUP                                               │
  16. #!│PrimaryDriverCheck    GROUP                                               │
  17. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  18. #!│Version   Comments                                                        │
  19. #!│────────  ────────────────────────────────────────────────────────────────│
  20. #!│3007.000  Release of CDD3 version 3007 templates                          │
  21. #!│3007.101  Repaired RIUpdates GROUP                                        │
  22. #!│          Repaired RIDeletes GROUP                                        │
  23. #!│          Modified PrimaryDriverCheck GROUP                               │
  24. #!│          Modified DriverCheck GROUP                                      │
  25. #!│3007.103  Repaired RIUpdates GROUP                                        │
  26. #!│          Repaired RIDeletes GROUP                                        │
  27. #!│3007.105  Repaired InitLogout GROUP                                       │
  28. #!│          Repaired BtrieveTrxFraming GROUP                                │
  29. #!└──────────────────────────────────────────────────────────────────────────┘
  30. #!
  31. #!***************************************************************************
  32. #GROUP(%RIUpdates)                               #!Perform Referential Updates
  33. #!
  34. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  35. #!│                                RIUpdates               │Version: 3007.103│
  36. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  37. #!│Purpose:      Constructs RI Update code                                   │
  38. #!│Called From:  FORM.TPX and MULTIPG.TPX (Near the end)                     │
  39. #!│Assumptions:  None                                                        │
  40. #!│Inserts:      WriteUpdates (perform RI updates)                           │
  41. #!│              InitLogout (performs transaction logging)                   │
  42. #!│              RIRestrictMsg (warns user if constrained as restricted)     │
  43. #!│              AbortTransactionMsg (warns user if transaction aborted)     │
  44. #!│              RIUpdateError (warns user on RI update error)               │
  45. #!│Symbols Set:  None                                                        │
  46. #!│Notes:        None                                                        │
  47. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  48. #!│Version   Comments                                                        │
  49. #!│────────  ────────────────────────────────────────────────────────────────│
  50. #!│3007.000  Release of CDD3 version 3007 templates                          │
  51. #!│3007.101  Repaired code generating the %LogoutList symbol.  Primary needed│
  52. #!│          to be added to the list.                                        │
  53. #!│3007.103  Moved AbortTransactionMsg #INSERT to build and display the      │
  54. #!│          message before the ROLLBACK occurs.  This was done because      │
  55. #!│          the error is reset after ROLLBACK.  In addition, the ShowWarning│
  56. #!│          was removed from the AbortTransactionMsg #GROUP and placed after│
  57. #!│          the ROLLBACK.                                                   │
  58. #!└──────────────────────────────────────────────────────────────────────────┘
  59. #!
  60. #FOR(%File)                                      #! Cycle through each file
  61.   #SET(%FileIsParent,%Null)                      #! Is the file a parent?
  62.   #SET(%FileIsChild,%Null)                       #! Is the file a child?
  63.   #SET(%RIUpdateNeeded,%Null)                    #! Is an RI Update necessary?
  64.   #SET(%CheckPre,('['&%FilePre&']'))             #! Setup to find %File Prefix
  65.   #IF((INSTRING(%CheckPre,%UpdateParentList,1,1)))#!Search for file as parent
  66.     #SET(%FileIsParent,'TRUE')                   #! If it is, set that flag
  67.     #SET(%RIUpdateNeeded,'TRUE')                 #! And RI Routine is needed
  68.   #ENDIF                                         #! END (IF a Parent)
  69.   #IF((INSTRING(%CheckPre,%UpdateChildList,1,1)))#! Search for file as child
  70.     #SET(%FileIsChild,'TRUE')                    #! If it is, set that flag
  71.     #SET(%RIUpdateNeeded,'TRUE')                 #! And RI Routine is needed
  72.   #ENDIF                                         #! END (IF a Child)
  73.   #IF(%RIUpdateNeeded)                           #! If either parent or child
  74.     #IF(%FIleIsChild)                            #! If a child relation in proc
  75.       #FOR(%Relation)                            #! For every relation
  76.         #SET(%RelationString,('['&%RelationPre&'∙'&%FilePre&']'))
  77.                                                  #! Setup to find relationship
  78.                                                  #! between file and parents
  79.         #IF((INSTRING(%RelationString,%UpdateRelations,1,1)))
  80.                                                  #! If the relation was
  81.                                                  #! flagged for RI Code Generation
  82. #INSERT(%WriteUpdates)                           #! Write the update code
  83.         #ENDIF                                   #! END (IF the relation...)
  84.       #ENDFOR                                    #! END (FOR every relation...)
  85.     #ELSE                                        #! ELSE (If not child)
  86.                                                  #! (Should only apply to
  87.                                                  #! %Primary)
  88. #INSERT(%WriteUpdates)                           #! Write the update code
  89.     #ENDIF                                       #! END (IF a Child)
  90.   #ENDIF                                         #! END (IF RI Update needed)
  91. #ENDFOR                                          #! END (FOR File)
  92. #IF(%UpdateChildList)                            #!IF RI Update Children
  93. !─────────────────────────────────────────────────────────────────────────────
  94. ConstrainedUpdate ROUTINE                        #<!Perform RI Updates
  95.   CLEAR(RI:RestrictUpdate,0)                     #<! Clear Restrict Flag
  96.   CLEAR(AbortTransaction,0)                      #<! Clear ABORT flag
  97.   DO OpenRIUpdateFiles                           #<! Open files used
  98.   #SET(%LogoutFrom,'Update')
  99.   #INSERT(%InitLogout)                           #!Insert Logout Code
  100.   DO Update:%Primary                             #<! Perform the Updates
  101.   IF RI:RestrictUpdate                           #<! If update was restricted
  102.     #INSERT(%RIRestrictMsg)                      #! Alert the User
  103.   #IF(%NoLogoutSupport=%Null)                    #!If supporting logout
  104.     ROLLBACK                                     #<! Rollback transaction
  105.   #ENDIF                                         #!END (If supporting logout)
  106.     AbortTransaction = True                      #<! Set the ABORT flag
  107.   #IF(%CloseFiles)
  108.     DO CloseRIUpdateFiles
  109.   #ENDIF
  110.     EXIT                                         #<! and exit the routine
  111.   END                                            #<! END (If restricted update)
  112.   PUT(%Primary)                                  #<! Put %Primary
  113.   #IF(%NoLogoutSupport=%Null)                    #!If supporting logout
  114.   IF ~ERRORCODE()                                #<! If the Parent update Ok
  115.     COMMIT                                       #<! Commit the transaction
  116.   ELSE                                           #<! else on any error
  117.     AbortTransaction = True                      #<! Set the ABORT flag
  118.     #INSERT(%AbortTransactionMsg)                #! Alert the user
  119.     ROLLBACK                                     #<! Rollback the transaction
  120.     ShowWarning                                  ! Show warning
  121.   END                                            #<! End If ErrorCode()
  122.   #ELSE                                          #!NoLogoutSupport
  123.   IF ERRORCODE()                                 #<! Was the update ok?
  124.     AbortTransaction = True                      #<! Set the ABORT flag
  125.     #INSERT(%RIUpdateError)                      #! Alert the User
  126.   END                                            ! END (If ErrorCode)
  127.   #ENDIF                                         #!END (If supporting logout)
  128.   #IF(%CloseFiles)
  129.   DO CloseRIUpdateFiles
  130.   #ENDIF
  131.   EXIT                                           #<! Exit the ROUTINE
  132. !─────────────────────────────────────────────────────────────────────────────
  133. OpenRIUpdateFiles ROUTINE                        #<!Open files used in update
  134.   #FOR(%File)                                    #!For Each File
  135.     #SET(%ChildString,('['&%FilePre&']'))        #!Setup to find as child
  136.     #IF((INSTRING(%ChildString,%UpdateChildList,1,1)))#!If %File is Child
  137.       #IF(%CloseFiles)                           #!If Closing opened files
  138.   %FilePre::Opened = CheckOpen(%File)            #<! Open %FIle (If Necessary)
  139.       #ELSE                                      #!ELSE (If not closing files)
  140.   CheckOpen(%File)                               #<! Open %FIle (If Necessary)
  141.       #ENDIF                                     #!END (If Closing open files)
  142.     #ENDIF                                       #!END (If file is child)
  143.   #ENDFOR                                        #!END (For Each File)
  144.   #IF(%CloseFiles)
  145. !─────────────────────────────────────────────────────────────────────────────
  146. CloseRIUpdateFiles ROUTINE
  147.     #FOR(%File)                                  #!For Each File
  148.       #SET(%ChildString,('['&%FilePre&']'))      #!Setup to find as child
  149.       #IF((INSTRING(%ChildString,%UpdateChildList,1,1)))#!If %File is Child
  150.   IF %FilePre::Opened THEN CLOSE(%File).        #<! IF Opened here, close here
  151.       #ENDIF                                     #!END (If file is child)
  152.     #ENDFOR                                      #!END (For Each File)
  153.   #ENDIF
  154. #ENDIF                                           #!END (If update Child)
  155. #!***************************************************************************
  156. #GROUP(%WriteUpdates)                            #!Perform Referential Updates
  157.  
  158. #IF(%FileIsChild)                                #!If part of child relationship
  159. !─────────────────────────────────────────────────────────────────────────────
  160. Update:%RelationPre::%FilePre ROUTINE            #<!%Relation - %File
  161.                                                  ! Constraint: %RelationConstraintUpdate
  162. #ELSE                                            #!Otherwise (Parent Only)
  163. !─────────────────────────────────────────────────────────────────────────────
  164. Update:%File ROUTINE                             #<!RI Update of %File
  165. #ENDIF                                           #!END (If Child)
  166. #SET(%SaveFile,%File)                            #!Save the value of %File
  167. #SET(%SaveRelation,%Relation)                    #!And the value of %Relation
  168. #IF(%FileIsChild)                                #!Is the file a child
  169.                                                  #!(This code applies to all
  170.                                                  #! files but %Primary)
  171.   #FIX(%File,%SaveRelation)                      #!And swap the relationship
  172.   #FIX(%Relation,%SaveFile)                      #!for correct symbol access
  173.   #SET(%KeyFieldCounter,'0')                     #!Clear Field Counter
  174.   #FOR(%RelationKeyField)                        #!For each field in key
  175.     #IF(%RelationKeyFieldLink)                   #!If the field is linked
  176.       #SET(%KeyFieldCounter,(%KeyFieldCounter+1))#!Increment Field Counter
  177.     #ENDIF                                       #!END (If field is linked)
  178.   #ENDFOR                                        #!END (For relation field)
  179.   #SET(%IfWritten,%Null)                         #!Prepare For If Structure
  180.   #FOR(%RelationKeyField)                        #!For each field in key
  181.     #IF(%KeyFieldCounter='1')                    #!If this is last link field
  182.       #IF(%IfWritten)                            #!If the IF statement written
  183.   AND %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink #<! Check against save value
  184.       #ELSE                                      #!If IF not written yet
  185.   IF %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink #<! Check against save value
  186.       #ENDIF                                     #!END (If IF Written)
  187.       #BREAK                                     #!Break out of loop
  188.     #ELSE                                        #!otherwise (Counter > 1)
  189.       #IF(%IfWritten)                            #!If the IF statement written
  190.   AND %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  191.       #ELSE                                      #!If IF not written yet
  192.   IF %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  193.       #ENDIF                                     #!END (If IF Written)
  194.     #ENDIF                                       #!END (If Field Counter = 1)
  195.     #SET(%KeyFieldCounter,(%KeyFieldCounter-1))  #!Decrement Counter
  196.     #SET(%IfWritten,'TRUE')                      #!The IF statement written
  197.   #ENDFOR                                        #!END (For Relation Field)
  198.     EXIT                                         #<! If Save Value Match, Exit
  199.   END                                            #<! END (If Save Values Match)
  200.   #FIX(%File,%SaveRelation)                      #!And swap the relationship
  201.   #FIX(%Relation,%SaveFile)                      #!for correct symbol access
  202.   GET(%Relation,0)                               #<! Disconnect record buffer
  203.   CLEAR(%RelationPre:Record,-1)                  #<! Clear record
  204.   #SET(%KeyFieldCounter,'0')                     #!Clear Field Counter
  205.                                                  #!Field Counter is used to
  206.                                                  #!construct a readable IF
  207.                                                  #!structure inside loop.
  208.                                                  #!Inside the loop, we search
  209.                                                  #!each field of key, but use
  210.                                                  #!Field Counter instead of
  211.                                                  #!%RelationalKeyFieldLink
  212.   #FOR(%RelationKeyField)                        #!For each field in key
  213.     #IF(%RelationKeyFieldLink)                   #!If the field is linked
  214.       #SET(%KeyFieldCounter,(%KeyFieldCounter+1))#!Increment Field Counter
  215.   %RelationKeyField = %RelationPre::%RelationKeyFieldLink #<! Set to original value
  216.     #ENDIF                                       #!END (If field is linked)
  217.   #ENDFOR                                        #!END (For relation field)
  218.   SET(%RelationKey,%RelationKey)                 #<! Set for sequential access
  219.   LOOP                                           ! Search through records
  220.     NEXT(%Relation)                              #<! Get the next record
  221.     IF ERRORCODE() THEN BREAK.                   ! If out of records, break.
  222.   #SET(%IfWritten,%Null)                         #!Prepare For If Structure
  223.   #FOR(%RelationKeyField)                        #!For each field in key
  224.     #IF(%KeyFieldCounter='1')                    #!If this is last link field
  225.       #IF(%IfWritten)                            #!If the IF statement written
  226.     OR %RelationKeyField <> %RelationPre::%RelationKeyFieldLink #<! Check against save value
  227.       #ELSE                                      #!If IF not written yet
  228.     IF %RelationKeyField <> %RelationPre::%RelationKeyFieldLink #<! Check against save value
  229.       #ENDIF                                     #!END (If IF Written)
  230.       #BREAK                                     #!Break out of loop
  231.     #ELSE                                        #!otherwise (Counter > 1)
  232.       #IF(%IfWritten)                            #!If the IF statement written
  233.     OR %RelationKeyField <> %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  234.       #ELSE                                      #!If IF not written yet
  235.     IF %RelationKeyField <> %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  236.       #ENDIF                                     #!END (If IF Written)
  237.     #ENDIF                                       #!END (If Field Counter = 1)
  238.     #SET(%KeyFieldCounter,(%KeyFieldCounter-1))  #!Decrement Counter
  239.     #SET(%IfWritten,'TRUE')                      #!The IF statement written
  240.   #ENDFOR                                        #!END (For Relation Field)
  241.       BREAK                                      ! Break out of update loop
  242.     END                                          ! END (If out of range)
  243.   #IF(%RelationConstraintUpdate = 'RESTRICT')    #!If RESTRICTed update
  244.     ri:RestrictUpdate = True                     #<! Set Restricted Update flag
  245.     #FOR(%RelationKeyField)                      #!For each field in key
  246.       #IF(%RelationKeyFieldLink)                 #!If the field is linked
  247.     %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink #<! Set to original condition
  248.       #ENDIF                                     #!END (If field is linked)
  249.     #ENDFOR                                      #!END (For relation field)
  250.     DISPLAY()                                    ! Redisplay reset values
  251.     BREAK                                        ! BREAK from processing loop
  252.   #ELSE                                          #!ELSE (If not RESTRICT)
  253.     #IF(%FileIsParent)                           #!If the file is a parent
  254.       #FIX(%File,%SaveFile)                      #!Reset the file to original
  255.       #FOR(%Relation)                            #!For each relationship
  256.         #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  257.                                                   #!Setup to find relationship
  258.         #IF((INSTRING(%RelationString,%UpdateRelations,1,1)))
  259.                                                  #!Search for Relationship
  260.                                                  #!In Update Relation List
  261.           #FOR(%RelationKeyField)                #!For Each Field of Key
  262.             #IF(%RelationKeyFieldLink)           #!If the field is linked
  263.     %RelationPre::%RelationKeyFieldLink = %RelationKeyFieldLink #<! Save Link Field Value
  264.             #ENDIF                               #!END (IF Field is linked)
  265.           #ENDFOR                                #!END (FOR Each Key Field)
  266.         #ENDIF                                   #!END (IF valid relation)
  267.       #ENDFOR                                    #!END (FOR each relation)
  268.     #ENDIF                                       #!END (IF the file is parent)
  269.     #FIX(%File,%SaveRelation)                    #!FIX to process REL as FILE
  270.     #FIX(%Relation,%SaveFile)                    #!FIX to process FILE as REL
  271.     #IF(%RelationConstraintUpdate = 'CASCADE')   #!IF CASCADE constraint
  272.       #FOR(%RelationKeyField)                    #!For each field in key
  273.         #IF(%RelationKeyFieldLink)               #!If the field is linked
  274.     %RelationKeyField = %RelationKeyFieldLink    #<! Set to new value
  275.         #ENDIF                                   #!END (If field is linked)
  276.       #ENDFOR                                    #!END (For relation field)
  277.     #ELSE                                        #!ELSE (IF not CASCADE)
  278.       #FOR(%RelationKeyField)                    #!For each field in key
  279.         #IF(%RelationKeyFieldLink)               #!If the field is linked
  280.     CLEAR(%RelationKeyField,0)                   #<! Clear link field value
  281.         #ENDIF                                   #!END (If field is linked)
  282.       #ENDFOR                                    #!END (For relation field)
  283.     #ENDIF                                       #!ELSE (IF not CASCADE)
  284.     #FIX(%File,%SaveFile)                        #!Reset the file to original
  285.     #IF(%FileIsParent)                           #!If the file is a parent
  286.       #FOR(%Relation)                            #!For each relationship
  287.         #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  288.                                                   #!Setup to find relationship
  289.         #IF((INSTRING(%RelationString,%UpdateRelations,1,1)))
  290.                                                  #!Search for Relationship
  291.                                                  #!In Update Relation List
  292.     DO Update:%FilePre::%RelationPre             #<! Call Update Routine
  293.     IF ri:RestrictUpdate THEN EXIT.              ! If Restrict then exit
  294.         #ENDIF                                   #!END (IF valid relation)
  295.       #ENDFOR                                    #!END (FOR each relation)
  296.     #ENDIF                                       #!END (IF File is Parent)
  297.     PUT(%File)                                   #<! PUT updated record
  298.   #ENDIF                                         #!END (If RESTRICT Constraint)
  299.   END                                            ! END loop
  300.   EXIT                                           ! Exit to calling routine
  301. #ELSE                                            #!ELSE (If NOT a child)
  302.                                                  #!This applies only to
  303.                                                  #!%Primary
  304.   #FOR(%Relation)                                #!For each Relation
  305.     #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  306.                                                  #!Setup to find relationship
  307.     #IF((INSTRING(%RelationString,%UpdateRelations,1,1)))
  308.                                                  #!Search for Relationship
  309.                                                  #!In Update Relation List
  310.   DO Update:%FilePre::%RelationPre               #<! Call Update Routine
  311.   IF ri:RestrictUpdate THEN EXIT.                ! If Restrict then exit
  312.     #ENDIF                                       #!END (IF valid relation)
  313.   #ENDFOR                                        #!END (FOR each relation)
  314.   EXIT                                           #<! Exit to calling routine
  315. #ENDIF                                           #!ELSE (File is child)
  316. #!***************************************************************************
  317. #!
  318. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  319. #!│                                RIDeletes               │Version: 3007.103│
  320. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  321. #!│Purpose:      Constructs RI Delete code                                   │
  322. #!│Called From:  FORM.TPX and MULTIPG.TPX (Near the end)                     │
  323. #!│Assumptions:  None                                                        │
  324. #!│Inserts:      WriteDeletes (perform RI deletes)                           │
  325. #!│              InitLogout (performs transaction logging)                   │
  326. #!│              RIRestrictMsg (warns user if constrained as restricted)     │
  327. #!│              AbortTransactionMsg (warns user if transaction aborted)     │
  328. #!│              RIDeleteError (warns user on RI delete error)               │
  329. #!│Symbols Set:  None                                                        │
  330. #!│Notes:        None                                                        │
  331. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  332. #!│Version   Comments                                                        │
  333. #!│────────  ────────────────────────────────────────────────────────────────│
  334. #!│3007.000  Release of CDD3 version 3007 templates                          │
  335. #!│3007.101  Repaired code generating the %LogoutList symbol.  Primary needed│
  336. #!│          to be added to the list.                                        │
  337. #!│3007.103  Moved AbortTransactionMsg #INSERT to build and display the      │
  338. #!│          message before the ROLLBACK occurs.  This was done because      │
  339. #!│          the error is reset after ROLLBACK.  In addition, the ShowWarning│
  340. #!│          was removed from the AbortTransactionMsg #GROUP and placed after│
  341. #!│          the ROLLBACK.                                                   │
  342. #!└──────────────────────────────────────────────────────────────────────────┘
  343. #!
  344. #GROUP(%RIDeletes)                               #!Perform Referential Deletes
  345. #FOR(%File)                                      #!Cycle through each file
  346.   #SET(%FileIsParent,%Null)                      #!Is the file a parent?
  347.   #SET(%FileIsChild,%Null)                       #!Is the file a child?
  348.   #SET(%RIDeleteNeeded,%Null)                    #!Is an RI Delete necessary?
  349.   #SET(%CheckPre,('['&%FilePre&']'))             #!Setup to find %File Prefix
  350.   #IF((INSTRING(%CheckPre,%DeleteParentList,1,1))) #!Search for file as parent
  351.     #SET(%FileIsParent,'TRUE')                   #!If it is, set that flag
  352.     #SET(%RIDeleteNeeded,'TRUE')                 #!And RI Routine is needed
  353.   #ENDIF                                         #!END (IF a Parent)
  354.   #IF((INSTRING(%CheckPre,%DeleteChildList,1,1))) #!Search for file as child
  355.     #SET(%FileIsChild,'TRUE')                    #!If it is, set that flag
  356.     #SET(%RIDeleteNeeded,'TRUE')                 #!And RI Routine is needed
  357.   #ENDIF                                         #!END (IF a Child)
  358.   #IF(%RIDeleteNeeded)                           #!If we need to delete children
  359.     #IF(%FIleIsChild)                            #!If the file is a child
  360.       #FOR(%Relation)                            #!For Every Relation
  361.         #SET(%RelationString,('['&%RelationPre&'∙'&%FilePre&']'))
  362.                                                  #!Setup to find child relation
  363.         #IF((INSTRING(%RelationString,%DeleteRelations,1,1)))
  364.                                                  #!If the file is child
  365. #INSERT(%WriteDeletes)                           #!Write the delete code
  366.         #ENDIF                                   #!END (If file is child)
  367.       #ENDFOR                                    #!END (For Relation)
  368.     #ELSE                                        #!ELSE (File is parent only)
  369. #INSERT(%WriteDeletes)                           #!Write the Delete Code
  370.     #ENDIF                                       #!END (If File is Child)
  371.   #ENDIF                                         #!END (IF Delete Needed)
  372. #ENDFOR                                          #!END (For File)
  373. #IF(%DeleteChildList)                            #!IF RI Delete Children
  374.  
  375. !─────────────────────────────────────────────────────────────────────────────
  376. ConstrainedDelete ROUTINE                        !Perform RI Deletes
  377.   CLEAR(RI:RestrictDelete,0)                     ! Clear Restrict Flag
  378.   CLEAR(AbortTransaction,0)                      ! Clear ABORT flag
  379.   DO OpenRIDeleteFiles
  380.   #SET(%LogoutFrom,'Delete')
  381.   #INSERT(%InitLogout)                           #!Insert Logout Code
  382.   DO Delete:%Primary                             #<! Perform the Deletes
  383.   IF RI:RestrictDelete                           #<! If delete was restricted
  384.     #INSERT(%RIRestrictMsg)                      #!Alert the user
  385.   #IF(%NoLogoutSupport=%Null)                    #!If supporting logout
  386.     ROLLBACK                                     #<! Rollback transaction
  387.   #ENDIF                                         #!END (If supporting logout)
  388.     AbortTransaction = True                      #<! Set the ABORT flag
  389.   #IF(%CloseFiles)
  390.     DO CloseRIDeleteFiles
  391.   #ENDIF
  392.     EXIT                                         #<! and exit the routine
  393.   END                                            #<! END (If restricted delete)
  394.   DELETE(%Primary)                               #<! Put %Primary
  395.   #IF(%NoLogoutSupport=%Null)                    #!If supporting logout
  396.   IF ~ERRORCODE()                                #<! If the Parent delete Ok
  397.     COMMIT                                       ! Commit the transaction
  398.   ELSE                                           ! else on any error
  399.     AbortTransaction = True                      ! Set the ABORT flag
  400.     #INSERT(%AbortTransactionMsg)                #! Write Messages
  401.     ROLLBACK                                     ! Rollback the transaction
  402.     ShowWarning                                  ! Show warning
  403.   END                                            ! End If ErrorCode()
  404.   #ELSE                                          #!NoLogoutSupport
  405.   IF ERRORCODE()                                 #<! Was the delete ok?
  406.     AbortTransaction = True                      ! Set the ABORT flag
  407.     #INSERT(%RIDeleteError)                      #! Alert the  user
  408.   END                                            ! END (If ErrorCode)
  409.   #ENDIF                                         #!END (If supporting logout)
  410.   #IF(%CloseFiles)
  411.   DO CloseRIDeleteFiles
  412.   #ENDIF
  413.   EXIT                                           #<! EXIT ConstrainedDelete
  414. !─────────────────────────────────────────────────────────────────────────────
  415. OpenRIDeleteFiles ROUTINE                        #<!Open files used in update
  416.   #FOR(%File)                                    #!For Each File
  417.     #SET(%ChildString,('['&%FilePre&']'))        #!Setup to find as child
  418.     #IF((INSTRING(%ChildString,%DeleteChildList,1,1)))#!If %File is Child
  419.       #IF(%CloseFiles)                           #!If Closing opened files
  420.   %FilePre::Opened = CheckOpen(%File)            #<! Open %FIle (If Necessary)
  421.       #ELSE                                      #!ELSE (If not closing files)
  422.   CheckOpen(%File)                               #<! Open %FIle (If Necessary)
  423.       #ENDIF                                     #!END (If Closing open files)
  424.     #ENDIF                                       #!END (If file is child)
  425.   #ENDFOR                                        #!END (For Each File)
  426.   #IF(%CloseFiles)
  427. !─────────────────────────────────────────────────────────────────────────────
  428. CloseRIDeleteFiles ROUTINE
  429.     #FOR(%File)                                  #!For Each File
  430.       #SET(%ChildString,('['&%FilePre&']'))      #!Setup to find as child
  431.       #IF((INSTRING(%ChildString,%DeleteChildList,1,1)))#!If %File is Child
  432.   IF %FilePre::Opened THEN CLOSE(%File).        #<! IF Opened here, close here
  433.       #ENDIF                                     #!END (If file is child)
  434.     #ENDFOR                                      #!END (For Each File)
  435.   #ENDIF
  436. #ENDIF                                           #!END (If delete Child)
  437. #!***************************************************************************
  438. #GROUP(%WriteDeletes)                            #! Write Delete Routines
  439.  
  440. #IF(%FileIsChild)                                #!If the File is Child
  441. !─────────────────────────────────────────────────────────────────────────────
  442. Delete:%RelationPre::%FilePre ROUTINE            #<!%Relation - %File
  443.                                                  !Constraint: %RelationConstraintDelete
  444. #ELSE                                            #!Otherwise (Parent Only)
  445. !─────────────────────────────────────────────────────────────────────────────
  446. Delete:%File ROUTINE                             #<!Delete Parent Record
  447. #ENDIF                                           #!END (If Child)
  448. #SET(%SaveFile,%File)                            #!Save File for later use
  449. #SET(%SaveRelation,%Relation)                    #!Save Relation for later use
  450. #IF(%FileIsChild)                                #!Is the file a child
  451.   #FIX(%File,%SaveRelation)                      #!And swap the relationship
  452.   #FIX(%Relation,%SaveFile)                      #!for correct symbol access
  453.   GET(%Relation,0)                               #<! Disconnect record buffer
  454.   CLEAR(%RelationPre:Record,-1)                  #<! Clear %Relation record
  455.   #SET(%KeyFieldCounter,'0')                     #!Clear Field Counter
  456.                                                  #!Field Counter is used to
  457.                                                  #!construct a readable IF
  458.                                                  #!structure inside loop.
  459.                                                  #!Inside the loop, we search
  460.                                                  #!each field of key, but use
  461.                                                  #!Field Counter instead of
  462.                                                  #!%RelationalKeyFieldLink
  463.   #FOR(%RelationKeyField)                        #!For each field in key
  464.     #IF(%RelationKeyFieldLink)                   #!If the field is linked
  465.       #SET(%KeyFieldCounter,(%KeyFieldCounter+1)) #!Increment Field Counter
  466.   %RelationKeyField = %RelationPre::%RelationKeyFieldLink #<! Set to original value
  467.     #ENDIF                                       #!END (If field is linked)
  468.   #ENDFOR                                        #!END (For relation field)
  469.   SET(%RelationKey,%RelationKey)                 #<! Set for sequential access
  470.   LOOP                                           ! Search through records
  471.     NEXT(%Relation)                              #<! Get the next record
  472.     IF ERRORCODE() THEN BREAK.                   ! If out of records, break.
  473.   #SET(%IfWritten,%Null)                         #!Prepare For If Structure
  474.   #FOR(%RelationKeyField)                        #!For each field in key
  475.     #IF(%KeyFieldCounter='1')                    #!If this is last link field
  476.       #IF(%IfWritten)                            #!If the IF statement written
  477.     OR %RelationKeyField <> %RelationPre::%RelationKeyFieldLink #<! Check against save value
  478.       #ELSE                                      #!If IF not written yet
  479.     IF %RelationKeyField <> %RelationPre::%RelationKeyFieldLink #<! Check against save value
  480.       #ENDIF                                     #!END (If IF Written)
  481.       #BREAK                                     #!Break out of loop
  482.     #ELSE                                        #!otherwise (Counter > 1)
  483.       #IF(%IfWritten)                            #!If the IF statement written
  484.     OR %RelationKeyField <> %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  485.       #ELSE                                      #!If IF not written yet
  486.     IF %RelationKeyField <> %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  487.       #ENDIF                                     #!END If IF statement written
  488.     #ENDIF                                       #!END (If Field Counter = 1)
  489.     #SET(%KeyFieldCounter,(%KeyFieldCounter-1))  #!Decrement Counter
  490.     #SET(%IfWritten,'TRUE')                      #!SET IF Statement written flag
  491.   #ENDFOR                                        #!END (For Relation Field)
  492.       BREAK                                      ! Break out of delete loop
  493.     END                                          ! END (If out of range)
  494.   #IF(%RelationConstraintDelete = 'RESTRICT')#!If RESTRICTed delete
  495.     ri:RestrictDelete = True                     #<! Set Restricted Delete flag
  496.     BREAK                                        ! BREAK from processing loop
  497.   #ELSE                                          #!ELSE (If not RESTRICT)
  498.     #FIX(%File,%SaveFile)                        #!Reset the file to original
  499.     #IF(%FileIsParent)                           #!File is both Parent and Child
  500.       #FOR(%Relation)                            #!Get Each Relation
  501.         #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  502.                                                  #!Setup to find relationship
  503.         #IF((INSTRING(%RelationString,%DeleteRelations,1,1)))
  504.                                                  #!Search for Relationship
  505.                                                  #!In Delete Relation List
  506.           #FOR(%RelationKeyField)                #!For Each Field of Key
  507.             #IF(%RelationKeyFieldLink)           #!If the field is linked
  508.     %RelationPre::%RelationKeyFieldLink = %RelationKeyFieldLink #<! Save Link Field Value
  509.             #ENDIF                               #!END (IF Field is linked)
  510.           #ENDFOR                                #!END (FOR Each Key Field)
  511.     DO Delete:%FilePre::%RelationPre             #<! Call Delete Routine
  512.     IF ri:RestrictDelete THEN EXIT.              ! If Restrict then exit
  513.         #ENDIF                                   #!END (IF valid relationship)
  514.       #ENDFOR                                    #!END (FOR Relation)
  515.     #ENDIF                                       #!END (File is Parent)
  516.     #IF(%RelationConstraintDelete = 'CASCADE')#!IF CASCADE constraint
  517.     DELETE(%File)                                #<! DELETE record
  518.     #ELSIF(%RelationConstraintDelete = 'CLEAR')  #! If we clear link fields
  519.       #FOR(%RelationKeyField)                    #!For each field in key
  520.         #IF(%RelationKeyFieldLink)               #!If the field is linked
  521.     CLEAR(%RelationKeyField,0)                   #<! Clear link field value
  522.         #ENDIF                                   #!END (If field is linked)
  523.       #ENDFOR                                    #!END (For relation field)
  524.     PUT(%File)                                   #<! And put cleared record
  525.     #ENDIF                                       #!END (If file is parent)
  526.   #ENDIF                                         #!END (If RESTRICT Constraint)
  527.   END                                            ! END loop
  528.   EXIT                                           ! Exit to calling routine
  529. #ELSE                                            #!ELSE (If NOT a child)
  530.                                                  #!This applies only to
  531.                                                  #!%Primary
  532.   #FOR(%Relation)                                #!For each Relation
  533.     #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  534.                                                  #!Setup to find relationship
  535.     #IF((INSTRING(%RelationString,%DeleteRelations,1,1)))
  536.                                                  #!Search for Relationship
  537.                                                  #!In Delete Relation List
  538.   DO Delete:%FilePre::%RelationPre               #<! Call Delete Routine
  539.   IF ri:RestrictDelete THEN EXIT.                ! If Restrict then exit
  540.     #ENDIF                                       #!END (IF valid relation)
  541.   #ENDFOR                                        #!END (FOR each relation)
  542.   EXIT                                           #<! Exit to calling routine
  543. #ENDIF                                           #!ELSE (File is child)
  544. #!****************************************************************************
  545. #GROUP(%InitLogout)                              #!Initialize and check logout
  546. #!
  547. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  548. #!│                               InitLogout               │Version: 3007.105│
  549. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  550. #!│Purpose:      Generate the code necessary for Transaction Framing         │
  551. #!│Called From:  RIUpdates and RIDeletes GROUPs                              │
  552. #!│Assumptions:  None                                                        │
  553. #!│Inserts:      DriverCheck GROUP                                           │
  554. #!│              TransactionLockMsg                                          │
  555. #!│              TransactionErrorMsg                                         │
  556. #!│              BtrieveTrxFraming                                           │
  557. #!│Symbols Set:  None                                                        │
  558. #!│Notes:        None                                                        │
  559. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  560. #!│Version   Comments                                                        │
  561. #!│────────  ────────────────────────────────────────────────────────────────│
  562. #!│3007.000  Release of CDD3 version 3007 templates                          │
  563. #!│3007.105  Restructured the INSERTS of TransactionLockMsg and              │
  564. #!│          TransactionErrorMsg to set GLO:Messagex variables before the    │
  565. #!│          ROLLBACK.                                                       │
  566. #!└──────────────────────────────────────────────────────────────────────────┘
  567. #!
  568. #IF(%NoLogoutSupport=%Null)                      #! If logout supported
  569.   #SET(%LogoutList,(','&%Primary))               #! Initialize Logout List
  570.   #FOR(%File)                                    #! For Each File
  571.     #SET(%ChildString,('['&%FilePre&']'))        #! Setup to find as child
  572.     #IF(%LogoutFrom='Update')                    #! IF called from RIUpdates
  573.       #IF((INSTRING(%ChildString,%UpdateChildList,1,1)))#! If %File is Child
  574.         #INSERT(%DriverCheck)                    #! Check for Driver Type
  575.         #SET(%LogoutList,(%LogoutList&','&%File))#! Append %File to Logout List
  576.       #ENDIF                                     #! END (IF %File is Child)
  577.     #ELSE                                        #! ELSE (NOT called from RIUpdates)
  578.       #IF((INSTRING(%ChildString,%DeleteChildList,1,1)))#!If %File is Child
  579.         #INSERT(%DriverCheck)                    #! Check for Driver Type
  580.         #SET(%LogoutList,(%LogoutList&','&%File))#! Append %File to Logout List
  581.       #ENDIF                                     #! END (IF %File is Child)
  582.     #ENDIF                                       #! END (If file is child)
  583.   #ENDFOR                                        #! END (For Each File)
  584.   #SET(%LogoutList,('logout(2'&%LogoutList&')')) #! Prepare the logout code line
  585. %LogoutList                                      #<! Begin the transaction
  586. IF ERRORCODE()                                   #<! If logout unsuccessful
  587.   AbortTransaction = True                        #<! Set the Abort Flag
  588.   CASE ERRORCODE()                               #<! Check the errorcode
  589.   OF IsLockedErr                                 #<! IF File Locked
  590.     #INSERT(%TransactionLockMsg)                 #! Alert the user
  591.   ELSE                                           #<! Other Error
  592.     #INSERT(%TransactionErrorMsg)                #! Alert the user
  593.   END                                            #<! END (If File Locked)
  594.   ROLLBACK                                       #<! Rollback the transaction
  595.   ShowWarning                                    #<! Display the error
  596.   DISABLE(1,FIELDS())                            #<! Disable the screen fields
  597.   #IF(%FirstField)                               #! If First Field Designated
  598.   ENABLE(%FirstField)                            #<! Enable First Field
  599.   SELECT(%FirstField)                            #<! Select First Entry Field
  600.   #ELSE                                          #! Otherwise (~%FirstField)
  601.     #FIX(%ScreenField,'?Cancel')                 #! Try to get the Cancel button
  602.     #IF(%ScreenField)                            #! If we have a ?Cancel button
  603.   ENABLE(?Cancel)                                #<! Enable the ?Cancel Button
  604.   SELECT(?Cancel)                                #<! Select the ?Cancel Button
  605.     #ELSE                                        #! If no ?Cancel Button
  606.       #FIX(%ScreenField,'?OK')                   #! Try to get the Cancel button
  607.       #IF(%ScreenField)                          #! If we have a ?Cancel button
  608.   ENABLE(?OK)                                    #<! Enable the ?OK Button
  609.   SELECT(?OK)                                    #<! Select the ?OK Button
  610.       #ENDIF                                     #! END (If ?OK Button)
  611.     #ENDIF                                       #! END (If ?Cancel Button)
  612.   #ENDIF                                         #! END (If %FirstField)
  613.   #IF(%CloseFiles)                               #! IF Closing Unused Files
  614.     #IF(%LogoutFrom='Update')                    #! IF Called from Update
  615.   DO CloseRIUpdateFiles                          #<! Close files used
  616.     #ELSE                                        #! ELSE (IF Called from Delete)
  617.   DO CloseRIDeleteFiles                          #<! Close files used
  618.     #ENDIF                                       #! END (IF Called...)
  619.   #ENDIF                                         #! END (IF Closing Unused...)
  620.   EXIT                                           #<! Exit the Routine
  621. END                                              #<! No errors, start transaction
  622. #INSERT(%BtrieveTrxFraming)                      #! Btrieve transaction system
  623.                                                  #! requires that the acquisition
  624.                                                  #! of the record affected by the
  625.                                                  #! put take place between the
  626.                                                  #! logout and commit
  627. #ENDIF                                           #! END (If logout supported)
  628. #!***************************************************************************
  629. #GROUP(%BtrieveTrxFraming)                       #!Initialize Btrieve Transaction
  630. #!
  631. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  632. #!│                            BtrieveTrxFraming           │Version: 3007.105│
  633. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  634. #!│Purpose:      Generate code to construct proper Btrieve transaction       │
  635. #!│Called From:  InitLogout GROUP                                            │
  636. #!│Assumptions:  None                                                        │
  637. #!│Inserts:      RIRecNotAvailMsg GROUP                                      │
  638. #!│Symbols Set:  None                                                        │
  639. #!│Notes:        None                                                        │
  640. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  641. #!│Version   Comments                                                        │
  642. #!│────────  ────────────────────────────────────────────────────────────────│
  643. #!│3007.000  Release of CDD3 version 3007 templates                          │
  644. #!│3007.105  Restructured the INSERT of RIRecNotAvailMsg to set              │
  645. #!│          GLO:Messagex variables before the ROLLBACK.                     │
  646. #!└──────────────────────────────────────────────────────────────────────────┘
  647. #!
  648. #IF(%PrimaryDriver='Btrieve')                    #!If %Primary uses Btrieve
  649. SAV:SaveRecord = %FilePre:Record                 #<! Save the record image
  650.   #FOR(%FileMemo)                                #!For each memo
  651.     #FIX(%Field,%FileMemo)                       #!Get the Field ID
  652. SAV:%FieldID = %FileMemo                         #<! Save the memo image
  653.   #ENDFOR                                        #!END (For each memo)
  654. SAV:Position = POSITION(%Primary)                #<! Save the record position
  655. RESET(%Primary,SAV:Position)                     #<! and reset to position
  656. NEXT(%Primary)                                   #<! and reread the record
  657. IF SAV:Position <> POSITION(%Primary)            #<! If on a different record
  658.   AbortTransaction = True                        #<! ABORT the Update
  659.   #INSERT(%RIRecNotAvailMsg)                     #! Alert the user
  660.   ROLLBACK                                       #<! Roll back changes
  661.   ShowWarning                                    #<! Alert the User
  662.   EXIT                                           #<! And leave the routine
  663. END                                              #<! END (If not good record)
  664. %FilePre:Record = SAV:SaveRecord                 #<! Reset Record Value
  665.   #FOR(%FileMemo)                                #!For each memo
  666.     #FIX(%Field,%FileMemo)                       #!Fix the memo field
  667. %FileMemo = SAV:%FieldID                         #<! Reset the memo value
  668.   #ENDFOR                                        #!END (For each memo)
  669. #ENDIF                                           #!END (If using Btrieve)
  670. #!***************************************************************************
  671. #GROUP(%SavePrimaryLinks)                        #!Save Links to Primary
  672. #FIX(%File,%Primary)                             #!Setup to read primary
  673. #FOR(%Relation)                                  #!Get Each Relation
  674.   #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  675.                                                  #!Setup to find relationship
  676.   #IF((INSTRING(%RelationString,%AllRelations,1,1)))
  677.                                                  #!Search for Relationship
  678.                                                  #!In Update Relation List
  679.     #FOR(%RelationKeyField)                      #!For Each Field of Key
  680.       #IF(%RelationKeyFieldLink)                 #!If the field is linked
  681. %RelationPre::%RelationKeyFieldLink = %RelationKeyFieldLink #<! Save Link Field Value
  682.       #ENDIF                                     #!END (IF Field is linked)
  683.     #ENDFOR                                      #!END (FOR Each Key Field)
  684.   #ENDIF                                         #!END (IF valid relationship)
  685. #ENDFOR                                          #!END (FOR Relation)
  686. #!***************************************************************************
  687. #GROUP(%ConcurrentWrite)
  688. #IF(%SharedFiles)
  689.  
  690. !─────────────────────────────────────────────────────────────────────────────
  691. ConcurrentWrite ROUTINE
  692.   CLEAR(AbortTransaction,0)                      #<!Initialize AbortWrite#
  693.   #IF(%AutoInc)
  694.   IF AutoIncAdd THEN EXIT.                       #<!Not an Autoincrement ADD
  695.   #ENDIF
  696.   GET(RecordQueue,2)                             #<!Add the changed record
  697.   Sav:SaveRecord = %FilePre:Record               #<!Save Record to the Queue
  698.   #IF(%MemoChk)
  699.     #FOR(%FileMemo)
  700.       #FIX(%Field,%FileMemo)
  701.   SAV:%FieldID = %FileMemo                       #<!Save Memo to the Queue
  702.     #ENDFOR
  703.   #ENDIF
  704.   PUT(RecordQueue)
  705.   GET(RecordQueue,1)                             #<!Get the original record
  706.   RESET(%Primary,SavePointer)                    #<!Position to record on disk
  707.   HOLD(%Primary,2)                               #<!Set HOLD retry for 2 seconds
  708.   NEXT(%Primary)                                 #<!Read the record into buffer
  709.   IF ERRORCODE()                                 #<!Was there an error?
  710.     CASE ERRORCODE()                             #<!Process recoverable errors
  711.     OF IsHeldErr                                 #<!Record is already held
  712.       #INSERT(%TransactionHeldMsg)
  713.       SELECT(1)                                  #<!Place cursor on 1st field
  714.       RELEASE(%Primary)                          #<!Release the HOLD
  715.       AbortTransaction = True                    #<!Turn on AbortWrite#
  716.       EXIT                                       #<!Back to main Loop
  717.     ELSE                                         #<!On any other error
  718.       IF DiskError('File Access Error')          #<!Call the Diskerror function
  719.         RELEASE(%Primary)                        #<!Release the hold
  720.         FREE(RecordQueue)                        #<!Free the memory Queue
  721.         DISABLE(1,FIELDS())                      #<!Disable all screen fields
  722.   #IF(%FirstField)                               #!If First Field Designated
  723.         ENABLE(%FirstField)                      #<! Enable First Field
  724.         SELECT(%FirstField)                      #<! Select First Entry Field
  725.   #ELSE                                          #!Otherwise (~%FirstField)
  726.     #FIX(%ScreenField,'?Cancel')                 #!Try to get the Cancel button
  727.     #IF(%ScreenField)                            #!If we have a ?Cancel button
  728.         ENABLE(?Cancel)                          #<! Enable the ?Cancel Button
  729.         SELECT(?Cancel)                          #<! Select the ?Cancel Button
  730.     #ELSE                                        #!If no ?Cancel Button
  731.       #FIX(%ScreenField,'?OK')                   #!Try to get the Cancel button
  732.       #IF(%ScreenField)                          #!If we have a ?Cancel button
  733.         ENABLE(?OK)                              #<! Enable the ?OK Button
  734.         SELECT(?OK)                              #<! Select the ?OK Button
  735.       #ENDIF                                     #!END (If ?OK Button)
  736.     #ENDIF                                       #!END (If ?Cancel Button)
  737.   #ENDIF                                         #!END (If %FirstField)
  738.         AbortTransaction = True                  #<!Turn on AbortWrite#
  739.         EXIT                                     #<!and exit the routine
  740.       END                                        #<!End IF Diskerror
  741.     END                                          #<!End CASE Errorcode()
  742.   ELSIF Sav:SaveRecord <> %FilePre:Record        #<!Has the record been changed
  743.     Sav:SaveRecord = %FilePre:Record             #<!Then update the Queue record
  744.   #IF(%MemoChk = 'Y')
  745.     #FOR(%FileMemo)
  746.       #FIX(%Field,%FileMemo)
  747.     SAV:%FieldID = %Field                        #<!Then update the Queue memo
  748.     #ENDFOR
  749.   #ENDIF
  750.     #INSERT(%ConflictUpdate)
  751.   #IF(%MemoChk = 'Y')
  752.     #FOR(%FileMemo)
  753.       #FIX(%Field,%FileMemo)
  754.   ELSIF SAV:%FieldID <> %Field                   #<!Has the Memo been changed?
  755.     SAV:%FieldID = %Field                        #<!Then update the Queue memo
  756.     #INSERT(%ConflictUpdate)
  757.     #ENDFOR
  758.   #ENDIF
  759.   ELSE                                           #<!Its ok to update the file
  760.     GET(RecordQueue,2)                           #<!Retrieve the users changes
  761.     %FilePre:Record = Sav:SaveRecord             #<!Move changes to record buffer
  762.   #IF(%MemoChk)
  763.     #FOR(%FileMemo)
  764.       #FIX(%Field,%FileMemo)
  765.     %Field = SAV:%FieldID                        #<!Move Memo to buffer
  766.     #ENDFOR
  767.   #ENDIF
  768.   END                                            #<!End IF Errorcode()
  769.   EXIT
  770. #ENDIF
  771. #!***************************************************************************
  772. #GROUP(%ConcurrentDelete)
  773. #IF(%SharedFiles)
  774.  
  775. !─────────────────────────────────────────────────────────────────────────────
  776. ConcurrentDelete ROUTINE
  777.   AbortTransaction = False
  778.   RESET(%Primary,SavePointer)                    #<!Set position in Primary file
  779.   HOLD(%Primary,2)                               #<!Hold the record
  780.   NEXT(%Primary)                                 #<!Read the record into buffer
  781.   IF ERRORCODE()                                 #<!Check for file access error
  782.     CASE ERRORCODE()                             #<!Case for recoverable errors
  783.     OF IsHeldErr                                 #<!Record is already held
  784.       #INSERT(%TransactionHeldMsg)
  785.       SELECT(1)                                  #<!Place cursor on 1st field
  786.       RELEASE(%Primary)                          #<!Release HOLD request
  787.       AbortTransaction = True                    #<!Set AbortDelete# ON
  788.       EXIT                                       #<!Re-start main LOOP
  789.     ELSE                                         #<!for any other error
  790.       IF DiskError('Unable to process current Record') #<!Call error function
  791.         #INSERT(%UnableToContinueMsg)
  792.         DO ProcedureReturn
  793.       END                                        #<!End IF Diskerror
  794.     END                                          #<!End CASE errorcode
  795.   ELSIF POSITION(%Primary) <> SavePointer        #<!Is the record already deleted?
  796.     RELEASE(%Primary)                            #<!Relase record Hold
  797.     DO ProcedureReturn                           #<!Return to the calling procedure
  798.   END                                            #<!End IF errorcode()
  799.   EXIT
  800. #ENDIF
  801. #!***************************************************************************
  802. #GROUP(%DriverCheck)
  803. #!
  804. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  805. #!│                               DriverCheck              │Version: 3007.101│
  806. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  807. #!│Purpose:      Checks that all files use the same driver                   │
  808. #!│Called From:  FORM and MULTIPG                                            │
  809. #!│Assumptions:  None                                                        │
  810. #!│Inserts:      None                                                        │
  811. #!│Symbols Set:  None                                                        │
  812. #!│Notes:        None                                                        │
  813. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  814. #!│Version   Comments                                                        │
  815. #!│────────  ────────────────────────────────────────────────────────────────│
  816. #!│3007.000  Release of CDD3 version 3007 templates                          │
  817. #!│3007.101  Changed comparison of %NoLogoutSupport to any non-null value.   │
  818. #!└──────────────────────────────────────────────────────────────────────────┘
  819. #!
  820. #IF(NOT %NoLogoutSupport)
  821.   #IF(%FileType <> %PrimaryDriver)
  822.     #SET(%ErrorMessage,%NULL)
  823.     #ERROR(%ErrorMessage)
  824.     #SET(%ErrorMessage,(' WARNING during Source Code Generation in Procedure: '& %Procedure ))
  825.     #ERROR(%ErrorMessage)
  826.     #SET(%ErrorMessage, ' the FILE Relationship uses multiple file drivers')
  827.     #ERROR(%ErrorMessage)
  828.     #SET(%ErrorMessage,(' see FORM Template Help, TOPIC: No Transaction Framing'))
  829.     #ERROR(%ErrorMessage)
  830.     #SET(%ErrorMessage,(' Set "Disable RI Logout" in Procedure Properties'))
  831.     #ERROR(%ErrorMessage)
  832.     #SET(%ErrorMessage,(' to prevent this message from appearing.'))
  833.     #ERROR(%ErrorMessage)
  834.     #SET(%ErrorMessage, %NULL)
  835.     #ERROR(%ErrorMessage)
  836.     #SET(%NoLogoutSupport,'Y')
  837.   #ENDIF
  838. #ENDIF
  839. #!***************************************************************************
  840. #GROUP(%PrimaryDriverCheck)
  841. #!
  842. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  843. #!│                           PrimaryDriverCheck           │Version: 3007.101│
  844. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  845. #!│Purpose:      Checks if the Driver for %Primary supports LOGOUT           │
  846. #!│Called From:  FORM and MULTIPG                                            │
  847. #!│Assumptions:  None                                                        │
  848. #!│Inserts:      None                                                        │
  849. #!│Symbols Set:  None                                                        │
  850. #!│Notes:        None                                                        │
  851. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  852. #!│Version   Comments                                                        │
  853. #!│────────  ────────────────────────────────────────────────────────────────│
  854. #!│3007.000  Release of CDD3 version 3007 templates                          │
  855. #!│3007.101  Added check of %NoLogoutSupport coming in to group              │
  856. #!└──────────────────────────────────────────────────────────────────────────┘
  857. #!
  858. #IF(NOT %NoLogoutSupport)
  859.   #IF((UPPER(%PrimaryDriver) <> 'BTRIEVE') AND (UPPER(%PrimaryDriver) <> 'CLARION'))
  860.     #SET(%ErrorMessage,%NULL)
  861.     #ERROR(%ErrorMessage)
  862.     #SET(%ErrorMessage,(' WARNING during Code Generation in Procedure: '& %Procedure ))
  863.     #ERROR(%ErrorMessage)
  864.     #SET(%ErrorMessage,( ' PRIMARY file driver (' & %PrimaryDriver & ') does not support LOGOUT() '))
  865.     #ERROR(%ErrorMessage)
  866.     #SET(%ErrorMessage,(' see FORM Template Help, Topic: No Transaction Framing'))
  867.     #ERROR(%ErrorMessage)
  868.     #SET(%ErrorMessage,(' Set "Disable RI Logout" in Procedure Properties'))
  869.     #ERROR(%ErrorMessage)
  870.     #SET(%ErrorMessage,(' to prevent this message from appearing.'))
  871.     #ERROR(%ErrorMessage)
  872.     #SET(%NoLogoutSupport,'Y')
  873.   #ENDIF
  874. #ENDIF
  875. #CHAIN('ScrnFlds.TPX')
  876.